The Haskell Tool Stack’s stack command can run a Haskell source file as a script, making use of a Stack interpreter options comment at the start of the file. Stack’s stack script command can also run a script file, but it ignores any interpreter options comment – all Stack flags and arguments must be specified on the command line. stack script offers a —no-run flag, which compiles the script to an executable but does not run the executable. It is used with one of two alternative flags: —compile or —optimize.
Somebody wanted to test that a script compiled but did not want to have to reproduce the content of the script’s interpreter options comment on the command line. That caused me to look at how Stack handles its command line.
commandLineHandler
Stack’s main function has the folowing line to handle command line options. The False argument indicates the the interpreter is not being used:
|
1 |
eGlobalRun <- try $ commandLineHandler currentDir progName False |
commandLineHandler is, essentially, a wrapper around complicatedOptions. I want to focus on the argument of that function which is the handler for parser failure: Just failureCallback. The argument has type Maybe (ParserFailure ParserHelp -> [String] -> IO (a, (b, a))).
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
commandLineHandler :: FilePath -> String -> Bool -> IO (GlobalOptsMonoid, RIO Runner ()) commandLineHandler currentDir progName isInterpreter = complicatedOptions (mkVersion' Meta.version) (Just versionString') hpackVersion "stack - The Haskell Tool Stack" "" "stack's documentation is available at https://docs.haskellstack.org/" (globalOpts OuterGlobalOpts) (Just failureCallback) addCommands where failureCallback f args = case stripPrefix "Invalid argument" (fst (renderFailure f "")) of Just _ -> if isInterpreter then parseResultHandler args f else secondaryCommandHandler args f >>= interpreterHandler currentDir args Nothing -> parseResultHandler args f |
If the interpreter is not being used, the secondaryCommandHandler is applied to the args and the result is fed into interpreterHandler.
Main.interpreterHandler is interesting because it applies commandLineHandler a second time, but this time with a True argument indicating the interpreter is being used:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
interpreterHandler :: Monoid t => FilePath -> [String] -> ParserFailure ParserHelp -> IO (GlobalOptsMonoid, (RIO Runner (), t)) interpreterHandler currentDir args f = do -- args can include top-level config such as --extra-lib-dirs=... (set by -- nix-shell) - we need to find the first argument which is a file, everything -- afterwards is an argument to the script, everything before is an argument -- to Stack (stackArgs, fileArgs) <- spanM (fmap not . D.doesFileExist) args case fileArgs of (file:fileArgs') -> runInterpreterCommand file stackArgs fileArgs' [] -> parseResultHandler (errorCombine (noSuchFile firstArg)) where firstArg = head args spanM _ [] = return ([], []) spanM p xs@(x:xs') = do r <- p x if r then do (ys, zs) <- spanM p xs' return (x:ys, zs) else return ([], xs) -- if the first argument contains a path separator then it might be a file, -- or a Stack option referencing a file. In that case we only show the -- interpreter error message and exclude the command related error messages. errorCombine = if pathSeparator `elem` firstArg then overrideErrorHelp else vcatErrorHelp overrideErrorHelp h1 h2 = h2 { helpError = helpError h1 } parseResultHandler fn = handleParseResult (overFailure fn (Failure f)) noSuchFile name = errorHelp $ stringChunk ("File does not exist or is not a regular file `" ++ name ++ "'") runInterpreterCommand path stackArgs fileArgs = do progName <- getProgName iargs <- getInterpreterArgs path let parseCmdLine = commandLineHandler currentDir progName True -- Implicit file arguments are put before other arguments that -- occur after "--". See #3658 cmdArgs = stackArgs ++ case break (== "--") iargs of (beforeSep, []) -> beforeSep ++ ["--"] ++ [path] ++ fileArgs (beforeSep, optSep : afterSep) -> beforeSep ++ [optSep] ++ [path] ++ fileArgs ++ afterSep (a, b) <- withArgs cmdArgs parseCmdLine return (a, (b, mempty)) |
System.Environment.withArgs :: [String] -> IO a -> IO a is from the base package. While executing action parseCmdLine (commandLineHandler currentDir progName True), getArgs will return cmdArgs.
Data.Attoparsec.Interpreter.getInterpreterArgs :: String -> IO [String] is also interesting. Its Haddock documentation explains that it extracts Stack arguments from a correctly-placed and correctly-formatted comment in the file. The actual parser is Data.Attoparsec.Interpreter.interpreterArgsParser :: Bool -> String -> Data.Attoparsec.Text.Parser String.
To summarise, complicatedOptions is applied to the command line arguments. If that does not work in a certain way (‘Invalid argument’), then the arguments are searched for an existing file. Assuming one exists, that file is parsed for arguments. If -- is present in the file’s arguments, they are split between pre- and post- that divider. The pre-divider arguments are added to the pre-file name arguments. The post-divider arguments are added to the post-file name arguments, then compilatedOptions is applied again to those command line arguments.
For example, assume the stack command with arguments stack-arg1 file.hs file-arg1 fails the first time around. If the arguments in existing file.hs are stack-arg2 -- file-arg2, then the Stack arguments tried the second time around are stack-arg1 stack-arg2 -- file.hs file-arg1 file-arg2.
As a more concrete example, assume the command stack stack-arg1 file.hs fails the first time around, and the arguments in file.hs are script stack-arg2 … stack-argN. What is tried the second time around is the equivalent of stack stack-arg1 script stack-arg2 … stack-argN — file.hs. If stack-arg1 forced the —no-run and —compile flags of the script command, then the person’s object would be met. I named stack-arg1 the new flag —-force-script-no-run-compile.
interpreterArgsParser
interpreterArgsParser makes use of exports from module Data.Attoparsec.Text of the attoparsec package (imported qualified with a P). I’ve reformatted its code below and added explanatory comments:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
interpreterArgsParser :: Bool -> String -> P.Parser String interpreterArgsParser isLiterate progName = -- `option` returns a default (here, "") if the parser fails without consuming input. -- `*>` discards the result of the first parser. P.option "" sheBangLine *> interpreterComment where -- `sheBangLine` matches (and discards) the string "#!" and then uses `manyTill` to -- match zero or more any characters (returned as an array of characters, a string) -- until the end of line is matched. `P.string "#!"` could have been coded as `"#!"` -- because there is an `IsString` instance - see further below. sheBangLine = P.string "#!" *> P.manyTill P.anyChar P.endOfLine -- The `isLiterate` argument determines which pair of alternative parsers applies. -- `Parser a` is an instance of `Alternative`, which provides: -- `(<|>) :: Parser a -> Parser a -> Parser a` interpreterComment = if isLiterate then literateLineComment <|> literateBlockComment else lineComment <|> blockComment -- Before looking at `lineComment` etc, this helper function matches (and discards) -- the start of a comment and then either matches: (a) the end and yields ""; or -- (b) something more complex (see further below). comment start end = commentStart start *> ((end >> return "") -- This alternative matches (and discards) a space character and then matches zero -- or more `anyCharNormalizeSpace` until the `end` is matched. See further below. -- The latter parser is named "-}" (`<?> "-}"`) for the purposes of reporting -- failure. <|> (P.space *> (P.manyTill anyCharNormalizeSpace end <?> "-}"))) -- This starts by matching (and discarding) using `psr` ... commentStart psr = (psr <?> (progName ++ " options comment")) -- .. it then matches (and discards) white space ... *> P.skipSpace -- before matching the `progName` argument. *> (P.string (pack progName) <?> show progName) -- Treat newlines as spaces inside the block comment -- `satisfyWith f p` transforms a `Char` with `f :: Char -> a` and then sees if the -- transformed value satisfies predicate `p :: a -> Bool`. Here, the predicate is -- constantly `True`. anyCharNormalizeSpace = let normalizeSpace c = if isSpace c then ' ' else c in P.satisfyWith normalizeSpace $ const True -- Now we can look at `lineComment`: it starts with "--" and ends with either an end -- of line or an end of input. The literal "--" works because `Parser a` is an -- instance of `IsString` (`a ~ Text => IsString (Parser a)`). lineComment = comment "--" (P.endOfLine <|> P.endOfInput) -- We can also look at `blockComment`: it starts with "{-" and ends with "-}". -- `(P.string "-}")` could have been coded as the literal "-}". blockComment = comment "{-" (P.string "-}") -- Before turning to the literate Haskell equivalents, `satisfy p` sees if `Char` -- satisfies predicate `p :: Char -> Bool`. `isHorizontalSpace :: Char -> Bool` -- detects space or horizontal tab characters. horizontalSpace = P.satisfy P.isHorizontalSpace literateLineComment = comment -- The start matches ">", one horizontal space, and "--". This format only allows one -- horizontal space character between the ">" and the "--". (">" *> horizontalSpace *> "--") -- The end matches an end of line or the end of input. (P.endOfLine <|> P.endOfInput) -- `literateBlockComment` is more complicated and does not make use of `comment`. literateBlockComment -- First it matches ">", one horizontal space, and "{-", which is all discarded = (">" *> horizontalSpace *> "{-") -- `skipMany` skips zero or more instances of the following parser *> P.skipMany -- `Parser a` is an instance of `Functor` which provides: -- `(<$) :: a -> Parser b -> Parser a` -- The left alternative matches one horizontal space and the result is replaced by -- a `String` (""). The right alternative matches an end of line and ">". (("" <$ horizontalSpace) <|> (P.endOfLine *> ">")) -- This matches (and discards) the `progName` argument. *> (P.string (pack progName) <?> progName) -- `manyTill' p end` applies `p :: Parser a` zero or more times until -- `end :: Parser a` succeeds, and returns the list of values returned by `p`. *> P.manyTill' -- The left alternative matches a character other than end of line characters. ( P.satisfy (not . P.isEndOfLine) -- The right alternative matches an end of line followed by ">", the result is -- replaced by a space. <|> (' ' <$ (P.endOfLine *> ">" <?> ">")) ) -- The end matches "-}". "-}" |